home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / programs.arc / GENI.PRO < prev    next >
Text File  |  1986-10-07  |  10KB  |  405 lines
  1. code = 2000
  2. /*
  3.   This is a small example of how to create a
  4.   classification expert-system in TURBO-
  5.   Prolog.
  6.  
  7.   Animals are classified in different
  8.   categories which are then broken up into
  9.   smaller categories. One can move from one
  10.   category to another if a number of
  11.   conditions are fullfilled.
  12.  
  13.   In this system the conditions are added
  14.   together. The first thing that is needed is
  15.   'or' and 'not'.
  16.  
  17.   Please understand this is a simple example
  18.   not a finished expert-system development
  19.   tool. */
  20.  
  21. DOMAINS
  22.   CONDITIONS = BNO*
  23.   HISTORY = RNO*
  24.   RNO, BNO, FNO = INTEGER
  25.   CATEGORY = SYMBOL
  26.   data_file = string
  27.   file = save_file
  28.   slist = string*
  29.  
  30. DATABASE
  31.   rule(RNO,CATEGORY,CATEGORY,CONDITIONS)
  32.   cond(BNO,STRING)
  33.   data_file(data_file)
  34.   yes(BNO)
  35.   no(BNO)
  36.   fact(FNO,CATEGORY,CATEGORY)
  37.   topic(string)
  38.  
  39. include "menu.pro"
  40.  
  41. PREDICATES
  42.  
  43. /*Commands*/
  44.   title_go
  45.   update
  46.   edit_kb
  47.   list
  48.   llist(HISTORY,string)
  49.   load_know
  50.   save_know
  51.   pick_dba(data_file)
  52.   erase
  53.   clear
  54.   proces(integer)
  55.   endd(integer)
  56.   listopt
  57.   evalans(char)
  58.   info(CATEGORY)
  59.   goes(CATEGORY)
  60.   run
  61.   repeat
  62.   reverse(CONDITIONS,CONDITIONS)
  63.   reverse1(CONDITIONS,CONDITIONS,CONDITIONS)
  64.   
  65.  
  66. /*Inferences mechanisms*/
  67.   go(HISTORY,CATEGORY)
  68.   check(RNO,HISTORY,CONDITIONS)
  69.   notest(BNO)
  70.   inpq(HISTORY,RNO,BNO,STRING)
  71.   do_answer(HISTORY,RNO,STRING,BNO,INTEGER)
  72.  
  73. /*Explanations*/
  74.   sub_cat(CATEGORY,CATEGORY,CATEGORY)
  75.   show_conditions(CONDITIONS,string)
  76.   show_rule(RNO,string)
  77.   show_cond(BNO,string)
  78.   report(HISTORY,string)
  79.   quest(CATEGORY,integer,integer,CATEGORY)
  80.  
  81. /*Update the knowledge*/
  82.   topict(string)
  83.   getrnr(RNO,RNO)
  84.   getbnr(BNO,BNO)
  85.   readcondl( CONDITIONS )
  86.   help
  87.   getcond(BNO,STRING)
  88.   save_y(char,string,data_file)
  89.  
  90. GOAL
  91.   makewindow(1,49,72,"",4,0,20,80),
  92.   makewindow(2,3,7,"",14,0,10,80),
  93.   makewindow(5,7,0,"",0,0,4,80),
  94.   makewindow(8,23,0,"",24,0,1,80),
  95.   makewindow(9,7,0,"",0,0,25,80),
  96.   run.
  97. clauses
  98.  run :-
  99.   repeat,
  100.   shiftwindow(8),
  101.   clearwindow,
  102.   write("  select option with arrow key  "),
  103.   shiftwindow(1),
  104.   menu(6,55,
  105.     ["Consultation",
  106.     "Load knowledge",
  107.     "Save knowledge",
  108.     "List knowledge",
  109.     "Update knowledge",
  110.     "Erase knowledge",
  111.     "Edit Knowledge",
  112.     "Help Information",
  113.     "DOS Shell",
  114.     "Exit Geni"],
  115.     CHOICE),
  116.     proces(CHOICE),
  117. endd(CHOICE),!.
  118.  
  119. /*Process Choice*/
  120.  
  121.  proces(0):-exit.
  122.  proces(1):-title_go.
  123.  proces(2):-load_know.
  124.  proces(3):-save_know.
  125.  proces(4):-list.
  126.  proces(5):-update.
  127.  proces(6):-erase.
  128.  proces(7):-edit_kb.
  129.  proces(8):-help.
  130.  proces(9):-write("Borland ",'\3','\2'," you"),system("").
  131.  proces(10).
  132.  
  133.  endd(0).
  134.  endd(10):- clearwindow,
  135.     write("Are you sure? (y or n) "),
  136.     readchar(C),write(C),
  137.     C='y',exit.
  138.  
  139. /*Inference mechanism*/
  140.  
  141.   title_go:-
  142.     goes(Mygoal),
  143.     nl,nl,go([],Mygoal),!.
  144.   title_go:- nl,
  145.     write("Sorry that one I did not know"),nl,update.
  146.  
  147.   goes(Mygoal):-
  148.     clear,clearwindow,
  149.     topict(Topic),
  150.     repeat,
  151.     write("You may select a general catagory( e.g. ",Topic,") \nor '?' for other options in the ",Topic,
  152.     " domain.\n Enter Goal "),
  153.     readln(Mygoal),
  154.     info(Mygoal),!.
  155.  
  156.   topict(Topic) :- topic(Topic).
  157.   topict(Topic) :- write("Enter a name that represents \nthis knowledge domain\n  : "),
  158.     readln(Topic),assert(topic(Topic)).
  159.  
  160.   go( _, Mygoal ):-                     /* My best guess  */
  161.     not(rule(_,Mygoal,_,_)),!,nl,
  162.     write("I think it is a(n): ",Mygoal),nl,nl,
  163.     write("I was right, wasn't I? (enter y or n)"),
  164.     readchar(Ans),
  165.     evalans(Ans).
  166.  
  167.   go( HISTORY, Mygoal ):-
  168.     rule(RNO,Mygoal,NY,COND),
  169.     check(RNO,HISTORY, COND),
  170.     go([RNO|HISTORY],NY).
  171.  
  172.   check( RNO, HISTORY, [BNO|REST] ):- yes(BNO), !,
  173.     check(RNO, HISTORY, REST).
  174.   check( _, _, [BNO|_] ):- no(BNO), !,fail.
  175.   check( RNO, HISTORY, [BNO|REST] ):- cond(BNO,NCOND),
  176.     fronttoken(NCOND,"not",_COND),
  177.     frontchar(_COND,_,COND),
  178.     cond(BNO1,COND),
  179.     notest(BNO1), !,
  180.     check(RNO, HISTORY, REST).
  181.   check(_,_, [BNO|_] ):- cond(BNO,NCOND),
  182.     fronttoken(NCOND,"not",_COND),
  183.     frontchar(_COND,_,COND),
  184.     cond(BNO1,COND),
  185.     yes(BNO1), !,fail.
  186.   check( RNO, HISTORY, [BNO|REST] ):-
  187.     cond(BNO,TEXT),
  188.     inpq(HISTORY,RNO,BNO,TEXT),
  189.     check(RNO, HISTORY, REST).
  190.     check( _, _, [] ).
  191.  
  192.   notest(BNO):-no(BNO),!.
  193.   notest(BNO):-not(yes(BNO)),!.
  194.  
  195.   inpq(HISTORY,RNO,BNO,TEXT):-
  196.     write("Is it true that ",TEXT,": "),
  197.     ROW = 14,
  198.     COL = 60,
  199.     menu(ROW,COL,[yes,no,why],CHOICE),
  200.     do_answer(HISTORY,RNO,TEXT,BNO,CHOICE).
  201.  
  202.   do_answer(_,_,_,_,0):-exit.
  203.   do_answer(_,_,_,BNO,1):-assert(yes(BNO)),
  204.     shiftwindow(1),write(yes),nl.
  205.   do_answer(_,_,_,BNO,2):-assert(no(BNO)),
  206.     shiftwindow(1),write(no),nl,fail.
  207.   do_answer(HISTORY,RNO,TEXT,BNO,3):- !,
  208.     shiftwindow(2),
  209.     rule( RNO, Mygoal1, Mygoal2, _ ),
  210.     sub_cat(Mygoal1,Mygoal2,Lstr),
  211.     concat("I try to show that: ",Lstr,Lstr1),
  212.     concat(Lstr1,"\nBy using rule number ",Ls1),
  213.     str_int(Str_num,RNO),
  214.     concat(Ls1,Str_num,Ans),
  215.     show_rule(RNO,Lls1),
  216.     concat(Ans,Lls1,Ans1),
  217.     report(HISTORY,Sng),
  218.     concat(Ans1,Sng,Answ),
  219.     display(Answ),
  220.     shiftwindow(8),
  221.     clearwindow,
  222.     write("   Use Arrow Keys To Select Option  "),
  223.     shiftwindow(1),
  224.     ROW = 14,COL = 60,
  225.     menu(ROW,COL,[yes,no,why],CHOICE),
  226.     do_answer(HISTORY,RNO,TEXT,BNO,CHOICE).
  227.  
  228. /* List Rules / Explanation Mechanism */
  229.  
  230.   list :- findall(RNO,rule(RNO,_,_,_),LIST),
  231.     llist(List,Str),!,display(Str),!.
  232.  
  233.   llist([],"") :-!.
  234.   llist([RNO|List],Str):-
  235.     llist(List,Oldstr),
  236.     show_rule(RNO,RNO_Str),
  237.     concat(RNO_Str,Oldstr,Str).
  238.  
  239.   show_rule(RNO,Strg):-
  240.     rule( RNO, Mygoal1, Mygoal2, CONDINGELSER),
  241.     str_int(RNO_str,RNO),
  242.     concat("\n Rule ",RNO_str,Ans),
  243.     concat(Ans,": ",Ans1),
  244.     sub_cat(Mygoal1,Mygoal2,Lstr),
  245.     concat(Ans1,Lstr,Ans2),
  246.     concat(Ans2,"\n     if ",Ans3),
  247.     reverse(CONDINGELSER,CONILS),
  248.     show_conditions(CONILS,Con),
  249.     concat(Ans3,Con,Strg).
  250.  
  251.   show_conditions([],"").
  252.   show_conditions([COND],Ans):-
  253.     show_cond(COND,Ans),!.
  254.   show_conditions([COND|REST],Ans):-
  255.     show_cond(COND,Text),
  256.     concat("\n    and ",Text,Nstr),
  257.     show_conditions(REST,Next_ans),
  258.     concat(Next_ans,Nstr,Ans).
  259.  
  260.   show_cond(COND,TEXT):-cond(COND,TEXT).
  261.  
  262.   sub_cat(Mygoal1,Mygoal2,Lstr):-
  263.     concat(Mygoal1," is a ",Str),
  264.     concat(Str,Mygoal2,Lstr).
  265.  
  266.   report([],"").
  267.   report([RNO|REST],Strg) :-
  268.     rule( RNO, Mygoal1, Mygoal2, _),
  269.     sub_cat(Mygoal1,Mygoal2,Lstr),
  270.     concat("\nI have shown that: ",Lstr,L1),
  271.     concat(L1,"\nBy using rule number ",L2),
  272.     str_int(Str_RNO,RNO),
  273.     concat(L2,Str_RNO,L3),
  274.     concat(L3,":\n ",L4),
  275.     show_rule(RNO,Str),
  276.     concat(L4,Str,L5),
  277.     report(REST,Next_strg),
  278.     concat(L5,Next_strg,Strg).
  279.  
  280. /*Update the knowledgebase*/
  281.  
  282.   getrnr(N,N):-not(rule(N,_,_,_)),!.
  283.   getrnr(N,N1):-H=N+1,getrnr(H,N1).
  284.  
  285.   getbnr(N,N):-not(cond(N,_)),!.
  286.   getbnr(N,N1):-H=N+1,getbnr(H,N1).
  287.  
  288.   readcondl( [BNO|R] ):-
  289.     write("condition: "),readln(COND),
  290.     COND><"",!,
  291.     getcond(BNO,COND),
  292.     readcondl( R ).
  293.   readcondl( [] ).
  294.  
  295.   getcond(BNO,COND):-cond(BNO,COND),!.
  296.   getcond(BNO,COND):-getbnr(1,BNO), assert( cond(BNO,COND) ).
  297.  
  298. /*EDIT KNOWLEDGE*/
  299.  
  300.   edit_kb :-
  301.     pick_dba(Filename),
  302.     file_str(Filename,Data),
  303.     edit(Data,NewData),clearwindow,
  304.     write("Save Knowledge Base (enter y or n) "),
  305.     readchar(Ans),save_y(Ans,NewData,Filename).
  306.  
  307.   save_y('y',D,Filename):-
  308.     openwrite(save_file,Filename),
  309.     writedevice(save_file),
  310.     write(D),
  311.     closefile(save_file).
  312.   save_y('n',_,_).
  313.  
  314. /*HELP !!!*/
  315.  
  316.    help :- file_str("geni.hlp",Help),
  317.     display(Help).
  318.  
  319.  
  320. /*User commands*/
  321.  
  322.   load_know:-pick_dba(Data), consult(Data).
  323.  
  324.   save_know :- data_file(Data), bound(Data),!,
  325.     save(Data),clearwindow,
  326.     writef(" Your % Knowledge base has been saved",Data).
  327.   save_know :- makewindow(11,10,9,"Name of the file",10,40,4,35),
  328.     write("Enter Knowledge\nBase Name: "),
  329.     readln(Data),
  330.     assert(data_file(Data)),
  331.     removewindow,
  332.     save(Data),clearwindow,
  333.     writef(" Your % Knowledge base has been saved",Data).
  334.  
  335.   pick_dba(Data) :- makewindow(10,7,7,"PICK A DATA FILE",10,10,10,60),
  336.     dir("//","*.dba",Data),removewindow.
  337.  
  338.   erase:-retract(_),fail.
  339.   erase.
  340.  
  341.   clear:-retract(yes(_)),retract(no(_)),fail,!.
  342.   clear.
  343.  
  344.   update:-
  345.     shiftwindow(5),
  346.     clearwindow,
  347.     write("\n\tUpdate knowledge\n\t****************\n"),
  348.     cursor(1,30),
  349.     write("Name of category: "),
  350.     cursor(3,30),
  351.     write("Name of subcategory: "),
  352.     cursor(1,50),
  353.     readln(KAT1),KAT1><"",
  354.     quest(KAT1,1,50,KAT),
  355.     cursor(3,50),
  356.     readln(SUB1),SUB1><"",
  357.     quest(SUB1,3,50,SUB),
  358.     readcondl(CONDL),
  359.     getrnr(1,RNO),
  360.     assert( rule(RNO,KAT,SUB,CONDL) ),update.
  361.  
  362.   quest(Q,X,Y,Q2):- Q = "?",
  363.     shiftwindow(2),clearwindow,
  364.     write("The categories and subcategories are objects. For example:\n"),nl,
  365.     write("subcategory|-----| category|-----|[condition1  |------|  condition2]\n"),
  366.     write("___________|_____|_______________|_____________|______|____________"),nl,
  367.     write("mammal     |is an| animal  |if it| has hair    |and it|  gives milk\n"),
  368.     write("bird       |is an| animal  |if it| has feathers|and it|  lays eggs\n"),
  369.     shiftwindow(5),
  370.     cursor(X,Y),
  371.     readln(Q2).
  372.   quest(Q,_,_,Q).
  373.  
  374.   info("?") :-
  375.     shiftwindow(2), clearwindow,
  376.     write("Enter the type of thing you are trying to classify."),
  377.     listopt,nl,nl, write(" press any key "),
  378.     readchar(_),
  379.     shiftwindow(1),clearwindow,fail.
  380.  
  381.   info(X) :- X>< "?".
  382.  
  383.   listopt :-
  384.     write(" The options are:\n\n"),
  385.     rule(_,Ans,_,_),
  386.     write(Ans,"  "),
  387.     fail.
  388.   listopt.
  389.  
  390.   evalans('y'):-
  391.     write("\nOf course, I am always right!").
  392.   evalans(_):-
  393.     write(" you're the boss \n  Update my Knowledge Base!"),!,run.
  394.  
  395.  /*system commands*/
  396.  
  397.   repeat.
  398.   repeat:-repeat.
  399.   
  400.   reverse(X,Y):-
  401.      reverse1([],X,Y).
  402.   reverse1(Y,[],Y).
  403.   reverse1(X1,[U|X2],Y):-reverse1([U|X1],X2,Y).
  404.   
  405.